home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / smlltalk / smtk_11.zoo / Date.st < prev    next >
Text File  |  1990-05-26  |  7KB  |  285 lines
  1. "======================================================================
  2. |
  3. |   Date Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1988, 1989, 1990 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbyrne     25 Apr 89      created.
  36. |
  37. "
  38.  
  39. Magnitude subclass: #Date
  40.       instanceVariableNames: 'days'
  41.       classVariableNames: ''
  42.       poolDictionaries: ''
  43.       category: nil.
  44.  
  45. Date comment: 
  46. 'My instances represent dates.  My base date is defined to be Jan 1, 1901.
  47. I provide methods for instance creation (including via "symbolic" dates, 
  48. such as "Date newDay: 14 month: #Feb year: 1990"' !
  49.  
  50. Smalltalk at: #DayNameDict put: Dictionary new!
  51. Smalltalk at: #MonthNameDict put: Dictionary new!
  52.  
  53. !Date class methodsFor: 'basic'!
  54.  
  55. initialize
  56.     self initDayNameDict.
  57.     self initMonthNameDict
  58. !
  59.  
  60. initDayNameDict
  61.     | dayNames |
  62.     dayNames _ #(
  63.                  (monday mon)    "1"
  64.                  (tuesday tue)    "2"
  65.                  (wednesday wed) "3"
  66.                  (thursday thu) "4"
  67.                  (friday fri)    "5"
  68.                  (saturday sat) "6"
  69.                  (sunday sun)    "7"
  70.                 ).
  71.     1 to: dayNames size do:
  72.         [ :dayIndex | (dayNames at: dayIndex) do:
  73.         [ :name | DayNameDict at: name put: dayIndex ] ].
  74. !
  75.  
  76. initMonthNameDict
  77.     | monthNames |
  78.     monthNames _ #(
  79.                  (january   jan)    "1"
  80.                  (february  feb)    "2"
  81.                  (march        mar)        "3"
  82.                  (april        apr)        "4"
  83.                  (may)                    "5"
  84.                  (june        jun)        "6"
  85.                  (july        jul)    "7"
  86.                  (august    aug)    "8"
  87.                  (september sep)    "9"
  88.                  (october   oct)    "10"
  89.                  (november  nov)    "11"
  90.                  (december  dec)    "12"
  91.                 ).
  92.     1 to: monthNames size do:
  93.         [ :monthIndex | (monthNames at: monthIndex) do:
  94.         [ :name | MonthNameDict at: name put: monthIndex ] ].
  95. !
  96.  
  97.  
  98. dayOfWeek: dayName
  99.     ^DayNameDict at: dayName asLowercase asSymbol
  100. !
  101.  
  102. nameOfDay: dayIndex
  103.     ^#(Monday Tuesday Wednesday Thursday Friday Saturday Sunday) at: dayIndex
  104. !
  105.  
  106. indexOfMonth: monthName
  107.     ^MonthNameDict at: monthName asLowercase asSymbol
  108. !
  109.  
  110. nameOfMonth: monthIndex
  111.     ^#(January February  March
  112.        April   May       June
  113.        July    August    September
  114.        October November  December) at: monthIndex
  115. !
  116.  
  117. daysInMonth: monthName forYear: yearInteger
  118.     | monthIndex |
  119.     monthIndex _ self indexOfMonth: monthName.
  120.     ^self daysInMonthIndex: monthIndex forYear: yearInteger
  121. !
  122.  
  123. daysInYear: yearInteger
  124.     ^365 + (self leapYear: yearInteger)
  125. !
  126.  
  127. leapYear: yearInteger
  128.     (yearInteger \\ 4 = 0
  129.         and: [ yearInteger \\ 100 ~= 0
  130.         or: [ yearInteger \\ 400 = 0 ] ]) 
  131.         ifTrue: [ ^1 ]
  132.     ifFalse: [ ^0 ]
  133. !
  134.  
  135. dateAndTimeNow
  136.     ^Array with: (Date today) with: (Time now)
  137. !!
  138.  
  139.  
  140.  
  141. !Date class methodsFor: 'instance creation'!
  142.  
  143. today
  144.     | now date |
  145.     now _ Time secondClock.
  146.     date _ now / (24 * 60 * 60).
  147.     ^self new setDays: date  + 25202 "(69 * 365 + 17)"
  148. !
  149.  
  150. fromDays: dayCount
  151.     ^self new setDays: dayCount
  152. !
  153.  
  154. newDay: dayCount year: yearInteger
  155.     ^self new setDays: (dayCount + self yearAsDays: yearInteger)
  156. !
  157.  
  158. newDay: day month: monthName year: yearInteger
  159.     ^self new setDays:
  160.         (day + (self daysUntilMonth: monthName year: yearInteger)
  161.              + (self yearAsDays: yearInteger))
  162. !!
  163.  
  164.  
  165.  
  166. !Date class methodsFor: 'private methods'!
  167.  
  168. yearAsDays: yearInteger
  169.     "Returns the number of days since Jan 1, 1901."
  170.     yearInteger _ yearInteger - 1900.
  171.     ^(yearInteger - 1) * 365
  172.         + (yearInteger // 4)
  173.     - (yearInteger // 100)
  174.     + (yearInteger // 400)
  175. !
  176.  
  177. daysUntilMonth: monthName year: yearInteger
  178.     | monthIndex totalDays |
  179.     totalDays _ 0.
  180.     monthIndex _ self indexOfMonth: monthName.
  181.     1 to: monthIndex - 1 do:
  182.         [ :index | totalDays _ totalDays + (self daysInMonthIndex: index
  183.                                              forYear: yearInteger) ].
  184.     ^totalDays
  185. !
  186.  
  187.  
  188. daysInMonthIndex: monthIndex forYear: yearInteger
  189.     | days |
  190.     days _ #(31 28 31        "Jan Feb Mar"
  191.             30 31 30        "Apr May Jun"
  192.         31 31 30        "Jul Aug Sep"
  193.         31 30 31        "Oct Nov Dec"
  194.         ) at: monthIndex.
  195.     monthIndex = 2
  196.         ifTrue: [ ^days + (self leapYear: yearInteger) ]
  197.     ifFalse: [ ^days ]
  198.  
  199. !!
  200.  
  201.  
  202. !Date methodsFor: 'basic'!
  203.  
  204. addDays: dayCount
  205.     days _ days + dayCount
  206. !
  207.  
  208. subtractDays: dayCount
  209.     days _ days - dayCount
  210. !
  211.  
  212. subtractDate: aDate
  213.     ^days - aDate days
  214. !!
  215.  
  216.  
  217.  
  218. !Date methodsFor: 'printing'!
  219.  
  220. printOn: aStream
  221.     self computeDateParts:
  222.         [ :year :month :day |
  223.         day printOn: aStream.
  224.            aStream nextPut: $-.
  225.         ((Date nameOfMonth: month) copyFrom: 1 to: 3) printOn: aStream.
  226.            aStream nextPut: $-.
  227.         year \\ 100 printOn: aStream ]
  228. !!
  229.  
  230.  
  231.  
  232. !Date methodsFor: 'storing'!
  233.  
  234. storeOn: aStream
  235.     "Won't work past around 1200 years in the future"
  236.     aStream nextPut: $(.
  237.     aStream nextPutAll: self classNameString.
  238.     self computeDateParts:
  239.         [ :year :month :day |
  240.         aStream nextPutAll: ' newDay: '.
  241.         day storeOn: aStream.
  242.         aStream nextPutAll: ' month: '.
  243.             (Date nameOfMonth: month) storeOn: aStream.
  244.         aStream nextPutAll: ' year: '.
  245.         year storeOn: aStream ].
  246.     aStream nextPut: $)
  247. !!
  248.  
  249.  
  250.  
  251. !Date methodsFor: 'private methods'!
  252.  
  253. days
  254.     ^days
  255. !
  256.  
  257. setDays: dayCount
  258.     days _ dayCount
  259. !
  260.  
  261. computeDateParts: aBlock
  262.     | yearInteger tempDays monthIndex daysInMonth |
  263.     tempDays _ days - (days // 1460) "4*365"
  264.                     + (days // 36500) "100*365"
  265.             - (days // 146000). "400*365"
  266.     yearInteger _ tempDays // 365.
  267.     "The +1 below makes tempDays be 1 based, instead of 0 based, so that the
  268.      first day is 1 Jan 1901 instead of 0 jan 1901"
  269.     tempDays _ days - (yearInteger * 365)
  270.             - (yearInteger // 4)
  271.             + (yearInteger // 100)
  272.             - (yearInteger // 400)
  273.             + 1.
  274.     yearInteger _ yearInteger + 1901.
  275.     monthIndex _ 1.
  276.     [ monthIndex < 12
  277.         and: [ daysInMonth _ Date daysInMonthIndex: monthIndex
  278.                               forYear: yearInteger.
  279.                tempDays > daysInMonth ] ] whileTrue:
  280.         [ monthIndex _ monthIndex + 1.
  281.       tempDays _ tempDays - daysInMonth ].
  282.     ^aBlock value: yearInteger value: monthIndex value: tempDays
  283. !!
  284.  
  285.